@@ -1,5 +1,21 @@
Revision history for MooseX-Types-Structured
+0.26 02 January 2011
+ - removed version from Test::Fatal as asked by the debian folks
+ - small documentation updates
+
+0.25 28 December 2010
+ - fixed bug where ->is_subtype_of dies meaninglessly when the type we
+ are trying to check is not a type we can find. This makes our
+ handling consistent with core Moose. Also changed ->equals and
+ ->is_a_type_of to be consistent.
+ - Added test case for above
+ - The test suite now uses Test::Fatal instead of Test::Exception (Karen
+ Etheridge).
+
+0.24 16 November 2010
+ - Added some performance enhancing caching code (phaeton)
+
0.23 01 july 2010
- Changes to the return value of ->validate that hopefully is both
backwardly compatible as well as more detailed. Now if you have
@@ -1,4 +1,4 @@
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@ b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2010 by John Napiorkowski.
+This software is Copyright (c) 2011 by John Napiorkowski.
This is free software, licensed under:
@@ -270,7 +270,7 @@ That's all there is to it!
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2010 by John Napiorkowski.
+This software is Copyright (c) 2011 by John Napiorkowski.
This is free software, licensed under:
@@ -28,6 +28,7 @@ t/10-recursion.t
t/11-overflow.t
t/12-error.t
t/13-deeper_error.t
+t/bug-is-subtype.t
t/bug-optional.t
t/regressions/01-is_type_of.t
t/release-eol.t
@@ -4,10 +4,11 @@
"John Napiorkowski <jjnapiork@cpan.org>",
"Florian Ragwitz <rafl@debian.org>",
"Yuval Kogman <nothingmuch@woobling.org>",
- "Tomas Doran <bobtfish@bobtfish.net>"
+ "Tomas Doran <bobtfish@bobtfish.net>",
+ "Robert Sedlacek <rs@474.at>"
],
"dynamic_config" : 0,
- "generated_by" : "Dist::Zilla version 4.101801, CPAN::Meta::Converter version 2.101670",
+ "generated_by" : "Dist::Zilla version 4.200000, CPAN::Meta::Converter version 2.102400",
"license" : [
"perl_5"
],
@@ -19,7 +20,7 @@
"prereqs" : {
"build" : {
"requires" : {
- "Test::Exception" : "0.27",
+ "Test::Fatal" : 0,
"Test::More" : "0.94"
}
},
@@ -49,7 +50,7 @@
"DateTime" : 0,
"MooseX::Types::DateTime" : 0,
"MooseX::Types::Moose" : 0,
- "Test::Exception" : 0,
+ "Test::Fatal" : 0,
"Test::More" : 0
}
}
@@ -67,98 +68,98 @@
"web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/MooseX-Types-Structured.git;a=summary"
}
},
- "version" : "0.23",
+ "version" : "0.26",
"x_Dist_Zilla" : {
"plugins" : [
{
"class" : "Dist::Zilla::Plugin::GatherDir",
"name" : "@FLORA/@Basic/GatherDir",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::PruneCruft",
"name" : "@FLORA/@Basic/PruneCruft",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::ManifestSkip",
"name" : "@FLORA/@Basic/ManifestSkip",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::MetaYAML",
"name" : "@FLORA/@Basic/MetaYAML",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::License",
"name" : "@FLORA/@Basic/License",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::Readme",
"name" : "@FLORA/@Basic/Readme",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::ExtraTests",
"name" : "@FLORA/@Basic/ExtraTests",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::ExecDir",
"name" : "@FLORA/@Basic/ExecDir",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::ShareDir",
"name" : "@FLORA/@Basic/ShareDir",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::MakeMaker",
"name" : "@FLORA/@Basic/MakeMaker",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::Manifest",
"name" : "@FLORA/@Basic/Manifest",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::TestRelease",
"name" : "@FLORA/@Basic/TestRelease",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::ConfirmRelease",
"name" : "@FLORA/@Basic/ConfirmRelease",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::UploadToCPAN",
"name" : "@FLORA/@Basic/UploadToCPAN",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::MetaConfig",
"name" : "@FLORA/MetaConfig",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::MetaJSON",
"name" : "@FLORA/MetaJSON",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::PkgVersion",
"name" : "@FLORA/PkgVersion",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::PodSyntaxTests",
"name" : "@FLORA/PodSyntaxTests",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::NoTabsTests",
@@ -168,12 +169,12 @@
{
"class" : "Dist::Zilla::Plugin::PodCoverageTests",
"name" : "@FLORA/PodCoverageTests",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::MetaResources",
"name" : "@FLORA/MetaResources",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::Authority",
@@ -188,12 +189,12 @@
{
"class" : "Dist::Zilla::Plugin::PodWeaver",
"name" : "@FLORA/PodWeaver",
- "version" : "3.101640"
+ "version" : "3.101641"
},
{
- "class" : "Dist::Zilla::Plugin::AutoPrereq",
- "name" : "@FLORA/AutoPrereq",
- "version" : "4.101801"
+ "class" : "Dist::Zilla::Plugin::AutoPrereqs",
+ "name" : "@FLORA/AutoPrereqs",
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs",
@@ -204,7 +205,7 @@
}
},
"name" : "Prereqs",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs",
@@ -215,27 +216,27 @@
}
},
"name" : "BuildRequires",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":InstallModules",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":TestFiles",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ExecFiles",
- "version" : "4.101801"
+ "version" : "4.200000"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ShareFiles",
- "version" : "4.101801"
+ "version" : "4.200000"
}
],
"zilla" : {
@@ -243,7 +244,7 @@
"config" : {
"is_trial" : 0
},
- "version" : "4.101801"
+ "version" : "4.200000"
}
},
"x_authority" : "cpan:JJNAPIORK"
@@ -5,17 +5,18 @@ author:
- 'Florian Ragwitz <rafl@debian.org>'
- 'Yuval Kogman <nothingmuch@woobling.org>'
- 'Tomas Doran <bobtfish@bobtfish.net>'
+ - 'Robert Sedlacek <rs@474.at>'
build_requires:
Data::Dumper: 0
DateTime: 0
MooseX::Types::DateTime: 0
MooseX::Types::Moose: 0
- Test::Exception: 0.27
+ Test::Fatal: 0
Test::More: 0.94
configure_requires:
ExtUtils::MakeMaker: 6.31
dynamic_config: 0
-generated_by: 'Dist::Zilla version 4.101801, CPAN::Meta::Converter version 2.101670'
+generated_by: 'Dist::Zilla version 4.200000, CPAN::Meta::Converter version 2.102400'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -37,81 +38,81 @@ resources:
bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types-Structured
homepage: http://search.cpan.org/dist/MooseX-Types-Structured
repository: git://git.moose.perl.org/MooseX-Types-Structured.git
-version: 0.23
+version: 0.26
x_Dist_Zilla:
plugins:
-
class: Dist::Zilla::Plugin::GatherDir
name: '@FLORA/@Basic/GatherDir'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::PruneCruft
name: '@FLORA/@Basic/PruneCruft'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::ManifestSkip
name: '@FLORA/@Basic/ManifestSkip'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::MetaYAML
name: '@FLORA/@Basic/MetaYAML'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::License
name: '@FLORA/@Basic/License'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::Readme
name: '@FLORA/@Basic/Readme'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::ExtraTests
name: '@FLORA/@Basic/ExtraTests'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::ExecDir
name: '@FLORA/@Basic/ExecDir'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::ShareDir
name: '@FLORA/@Basic/ShareDir'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::MakeMaker
name: '@FLORA/@Basic/MakeMaker'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::Manifest
name: '@FLORA/@Basic/Manifest'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::TestRelease
name: '@FLORA/@Basic/TestRelease'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::ConfirmRelease
name: '@FLORA/@Basic/ConfirmRelease'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::UploadToCPAN
name: '@FLORA/@Basic/UploadToCPAN'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::MetaConfig
name: '@FLORA/MetaConfig'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::MetaJSON
name: '@FLORA/MetaJSON'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::PkgVersion
name: '@FLORA/PkgVersion'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::PodSyntaxTests
name: '@FLORA/PodSyntaxTests'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::NoTabsTests
name: '@FLORA/NoTabsTests'
@@ -119,11 +120,11 @@ x_Dist_Zilla:
-
class: Dist::Zilla::Plugin::PodCoverageTests
name: '@FLORA/PodCoverageTests'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::MetaResources
name: '@FLORA/MetaResources'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::Authority
name: '@FLORA/Authority'
@@ -135,11 +136,11 @@ x_Dist_Zilla:
-
class: Dist::Zilla::Plugin::PodWeaver
name: '@FLORA/PodWeaver'
- version: 3.101640
+ version: 3.101641
-
- class: Dist::Zilla::Plugin::AutoPrereq
- name: '@FLORA/AutoPrereq'
- version: 4.101801
+ class: Dist::Zilla::Plugin::AutoPrereqs
+ name: '@FLORA/AutoPrereqs'
+ version: 4.200000
-
class: Dist::Zilla::Plugin::Prereqs
config:
@@ -147,7 +148,7 @@ x_Dist_Zilla:
phase: runtime
type: requires
name: Prereqs
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::Prereqs
config:
@@ -155,26 +156,26 @@ x_Dist_Zilla:
phase: build
type: requires
name: BuildRequires
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::FinderCode
name: ':InstallModules'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::FinderCode
name: ':TestFiles'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::FinderCode
name: ':ExecFiles'
- version: 4.101801
+ version: 4.200000
-
class: Dist::Zilla::Plugin::FinderCode
name: ':ShareFiles'
- version: 4.101801
+ version: 4.200000
zilla:
class: Dist::Zilla::Dist::Builder
config:
is_trial: 0
- version: 4.101801
+ version: 4.200000
x_authority: cpan:JJNAPIORK
@@ -10,13 +10,13 @@ use ExtUtils::MakeMaker 6.31;
my %WriteMakefileArgs = (
'ABSTRACT' => 'MooseX::Types::Structured - Structured Type Constraints for Moose',
- 'AUTHOR' => 'John Napiorkowski <jjnapiork@cpan.org>, Florian Ragwitz <rafl@debian.org>, Yuval Kogman <nothingmuch@woobling.org>, Tomas Doran <bobtfish@bobtfish.net>',
+ 'AUTHOR' => 'John Napiorkowski <jjnapiork@cpan.org>, Florian Ragwitz <rafl@debian.org>, Yuval Kogman <nothingmuch@woobling.org>, Tomas Doran <bobtfish@bobtfish.net>, Robert Sedlacek <rs@474.at>',
'BUILD_REQUIRES' => {
'Data::Dumper' => '0',
'DateTime' => '0',
'MooseX::Types::DateTime' => '0',
'MooseX::Types::Moose' => '0',
- 'Test::Exception' => '0.27',
+ 'Test::Fatal' => '0',
'Test::More' => '0.94'
},
'CONFIGURE_REQUIRES' => {
@@ -38,7 +38,7 @@ my %WriteMakefileArgs = (
'Sub::Exporter' => '0.982',
'overload' => '0'
},
- 'VERSION' => '0.23',
+ 'VERSION' => '0.26',
'test' => {
'TESTS' => 't/*.t t/regressions/*.t'
}
@@ -1,11 +1,11 @@
This archive contains the distribution MooseX-Types-Structured,
-version 0.23:
+version 0.26:
MooseX::Types::Structured - Structured Type Constraints for Moose
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -1,9 +1,10 @@
name = MooseX-Types-Structured
-version = 0.23
+version = 0.26
author = John Napiorkowski <jjnapiork@cpan.org>
author = Florian Ragwitz <rafl@debian.org>
author = Yuval Kogman <nothingmuch@woobling.org>
author = Tomas Doran <bobtfish@bobtfish.net>
+author = Robert Sedlacek <rs@474.at>
license = Perl_5
copyright_holder = John Napiorkowski
@@ -20,5 +21,5 @@ Sub::Exporter = 0.982
[Prereqs / BuildRequires]
Test::More = 0.94
-Test::Exception = 0.27
+Test::Fatal = 0
@@ -1,10 +1,8 @@
-package MooseX::Meta::TypeCoercion::Structured::Optional;
+package ## Hide from PAUSE
+ MooseX::Meta::TypeCoercion::Structured::Optional;
BEGIN {
$MooseX::Meta::TypeCoercion::Structured::Optional::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Meta::TypeCoercion::Structured::Optional::VERSION = '0.23';
-}
use Moose;
extends 'Moose::Meta::TypeCoercion';
@@ -64,11 +62,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -3,9 +3,6 @@ package ## Hide from PAUSE
BEGIN {
$MooseX::Meta::TypeCoercion::Structured::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Meta::TypeCoercion::Structured::VERSION = '0.23';
-}
# ABSTRACT: MooseX::Meta::TypeCoercion::Structured - Coerce structured type constraints.
use Moose;
@@ -55,11 +52,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -1,10 +1,8 @@
-package MooseX::Meta::TypeConstraint::Structured::Optional;
+package ## Hide from PAUSE
+ MooseX::Meta::TypeConstraint::Structured::Optional;
BEGIN {
$MooseX::Meta::TypeConstraint::Structured::Optional::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Meta::TypeConstraint::Structured::Optional::VERSION = '0.23';
-}
use Moose;
use MooseX::Meta::TypeCoercion::Structured::Optional;
@@ -55,11 +53,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -3,9 +3,6 @@ package ## Hide from PAUSE
BEGIN {
$MooseX::Meta::TypeConstraint::Structured::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Meta::TypeConstraint::Structured::VERSION = '0.23';
-}
# ABSTRACT: MooseX::Meta::TypeConstraint::Structured - Structured type constraints.
use Moose;
@@ -81,12 +78,7 @@ override 'validate' => sub {
sub generate_constraint_for {
my ($self, $type_constraints) = @_;
- return sub {
- my $arg = shift @_;
- my $constraint_generator = $self->constraint_generator;
- my $result = $constraint_generator->($type_constraints, $arg, $_[0]);
- return $result;
- };
+ return $self->constraint_generator->($self, $type_constraints);
}
@@ -144,7 +136,8 @@ around 'create_child_type' => sub {
sub equals {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
return unless $other->isa(__PACKAGE__);
@@ -157,7 +150,8 @@ sub equals {
sub is_a_type_of {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
if ( $other->isa(__PACKAGE__) and @{ $other->type_constraints || [] }) {
if ( $self->parent->is_a_type_of($other->parent) ) {
@@ -175,7 +169,8 @@ sub is_a_type_of {
sub is_subtype_of {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
if ( $other->isa(__PACKAGE__) ) {
if ( $other->type_constraints and $self->type_constraints ) {
if ( $self->parent->is_a_type_of($other->parent) ) {
@@ -377,11 +372,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -1,12 +1,12 @@
-package MooseX::Types::Structured::MessageStack;
+package ## Hide from PAUSE
+ MooseX::Types::Structured::MessageStack;
BEGIN {
$MooseX::Types::Structured::MessageStack::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Types::Structured::MessageStack::VERSION = '0.23';
-}
+
use Moose;
+
has 'level' => (
traits => ['Counter'],
is => 'ro',
@@ -19,6 +19,7 @@ has 'level' => (
},
);
+
has 'messages' => (
traits => ['Array'],
is => 'ro',
@@ -32,6 +33,7 @@ has 'messages' => (
},
);
+
sub as_string {
my @messages = (shift)->all_messages;
my @flattened_msgs = map {
@@ -55,6 +57,16 @@ __END__
MooseX::Types::Structured::MessageStack
+=head1 ATTRIBUTES
+
+=head2 level
+
+=head2 messages
+
+=head1 METHODS
+
+=head2 as_string
+
=head1 AUTHORS
=over 4
@@ -75,11 +87,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -1,10 +1,8 @@
-package MooseX::Types::Structured::OverflowHandler;
+package ## Hide from PAUSE
+ MooseX::Types::Structured::OverflowHandler;
BEGIN {
$MooseX::Types::Structured::OverflowHandler::AUTHORITY = 'cpan:JJNAPIORK';
}
-BEGIN {
- $MooseX::Types::Structured::OverflowHandler::VERSION = '0.23';
-}
use Moose;
@@ -66,11 +64,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -3,7 +3,7 @@ BEGIN {
$MooseX::Types::Structured::AUTHORITY = 'cpan:JJNAPIORK';
}
BEGIN {
- $MooseX::Types::Structured::VERSION = '0.23';
+ $MooseX::Types::Structured::VERSION = '0.26';
}
# ABSTRACT: MooseX::Types::Structured - Structured Type Constraints for Moose
@@ -43,6 +43,25 @@ my $Optional = MooseX::Meta::TypeConstraint::Structured::Optional->new(
}
);
+my $IsType = sub {
+ my ($obj, $type) = @_;
+
+ return $obj->can('equals')
+ ? $obj->equals($type)
+ : undef;
+};
+
+my $CompiledTC = sub {
+ my ($obj) = @_;
+
+ my $method = '_compiled_type_constraint';
+ return(
+ $obj->$IsType('Any') ? undef
+ : $obj->can($method) ? $obj->$method
+ : sub { $obj->check(shift) },
+ );
+};
+
Moose::Util::TypeConstraints::register_type_constraint($Optional);
Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
@@ -52,7 +71,8 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
parent => find_type_constraint('ArrayRef'),
constraint_generator=> sub {
## Get the constraints and values to check
- my ($type_constraints, $values) = @_;
+ my ($self, $type_constraints) = @_;
+ $type_constraints ||= $self->type_constraints;
my @type_constraints = defined $type_constraints ?
@$type_constraints : ();
@@ -62,50 +82,66 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
$overflow_handler = pop @type_constraints;
}
- my @values = defined $values ? @$values: ();
- ## Perform the checking
- while(@type_constraints) {
- my $type_constraint = shift @type_constraints;
- if(@values) {
- my $value = shift @values;
- unless($type_constraint->check($value)) {
- if($_[2]) {
- my $message = $type_constraint->validate($value,$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ my (@checks, @optional, $o_check, $is_compiled);
+ return sub {
+ my ($values, $err) = @_;
+ my @values = defined $values ? @$values : ();
+
+ ## initialise on first time run
+ unless ($is_compiled) {
+ @checks = map { $_->$CompiledTC } @type_constraints;
+ @optional = map { $_->is_subtype_of($Optional) } @type_constraints;
+ $o_check = $overflow_handler->$CompiledTC
+ if $overflow_handler;
+ $is_compiled++;
+ }
+
+ ## Perform the checking
+ VALUE:
+ for my $type_index (0 .. $#checks) {
+
+ my $type_constraint = $checks[ $type_index ];
+
+ if(@values) {
+ my $value = shift @values;
+
+ next VALUE
+ unless $type_constraint;
+
+ unless($type_constraint->($value)) {
+ if($err) {
+ my $message = $type_constraints[ $type_index ]->validate($value,$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
+ }
+ } else {
+ ## Test if the TC supports null values
+ unless ($optional[ $type_index ]) {
+ if($err) {
+ my $message = $type_constraints[ $type_index ]->get_message('NULL',$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
}
- return;
}
- } else {
- ## Test if the TC supports null values
- unless ($type_constraint->is_subtype_of($Optional)) {
- if($_[2]) {
- my $message = $type_constraint->get_message('NULL',$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ }
+
+ ## Make sure there are no leftovers.
+ if(@values) {
+ if($overflow_handler) {
+ return $o_check->([@values], $err);
+ } else {
+ if($err) {
+ my $message = "More values than Type Constraints!";
+ $err->add_message({message=>$message,level=>$err->level});
}
return;
}
- }
- }
- ## Make sure there are no leftovers.
- if(@values) {
- if($overflow_handler) {
- return $overflow_handler->check([@values], $_[2]);
} else {
- if($_[2]) {
- my $message = "More values than Type Constraints!";
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
- }
- return;
- }
- } elsif(@type_constraints) {
- if($_[2]) {
- my $message = "Not enough values for all defined type constraints. Remaining: ". join(', ',@type_constraints);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ return 1;
}
- return;
- } else {
- return 1;
- }
+ };
}
)
);
@@ -116,7 +152,8 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
parent => find_type_constraint('HashRef'),
constraint_generator => sub {
## Get the constraints and values to check
- my ($type_constraints, $values) = @_;
+ my ($self, $type_constraints) = @_;
+ $type_constraints = $self->type_constraints;
my @type_constraints = defined $type_constraints ?
@$type_constraints : ();
@@ -126,51 +163,65 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
$overflow_handler = pop @type_constraints;
}
my (%type_constraints) = @type_constraints;
- my %values = defined $values ? %$values: ();
- ## Perform the checking
- while(%type_constraints) {
- my($key, $type_constraint) = each %type_constraints;
- delete $type_constraints{$key};
- if(exists $values{$key}) {
- my $value = $values{$key};
- delete $values{$key};
- unless($type_constraint->check($value)) {
- if($_[2]) {
- my $message = $type_constraint->validate($value,$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+
+ my (%check, %optional, $o_check, $is_compiled);
+ return sub {
+ my ($values, $err) = @_;
+ my %values = defined $values ? %$values: ();
+
+ unless ($is_compiled) {
+ %check = map { ($_ => $type_constraints{ $_ }->$CompiledTC) } keys %type_constraints;
+ %optional = map { ($_ => $type_constraints{ $_ }->is_subtype_of($Optional)) } keys %type_constraints;
+ $o_check = $overflow_handler->$CompiledTC
+ if $overflow_handler;
+ $is_compiled++;
+ }
+
+ ## Perform the checking
+ KEY:
+ for my $key (keys %check) {
+ my $type_constraint = $check{ $key };
+
+ if(exists $values{$key}) {
+ my $value = $values{$key};
+ delete $values{$key};
+
+ next KEY
+ unless $type_constraint;
+
+ unless($type_constraint->($value)) {
+ if($err) {
+ my $message = $type_constraints{ $key }->validate($value,$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
+ }
+ } else {
+ ## Test to see if the TC supports null values
+ unless ($optional{ $key }) {
+ if($err) {
+ my $message = $type_constraints{ $key }->get_message('NULL',$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
}
- return;
}
- } else {
- ## Test to see if the TC supports null values
- unless ($type_constraint->is_subtype_of($Optional)) {
- if($_[2]) {
- my $message = $type_constraint->get_message('NULL',$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ }
+
+ ## Make sure there are no leftovers.
+ if(%values) {
+ if($overflow_handler) {
+ return $o_check->(+{%values});
+ } else {
+ if($err) {
+ my $message = "More values than Type Constraints!";
+ $err->add_message({message=>$message,level=>$err->level});
}
return;
}
- }
- }
- ## Make sure there are no leftovers.
- if(%values) {
- if($overflow_handler) {
- return $overflow_handler->check(+{%values});
} else {
- if($_[2]) {
- my $message = "More values than Type Constraints!";
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
- }
- return;
- }
- } elsif(%type_constraints) {
- if($_[2]) {
- my $message = "Not enough values for all defined type constraints. Remaining: ". join(', ',@type_constraints);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ return 1;
}
- return;
- } else {
- return 1;
}
},
)
@@ -182,7 +233,8 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
parent => find_type_constraint('HashRef'),
constraint_generator=> sub {
## Get the constraints and values to check
- my ($type_constraints, $values) = @_;
+ my ($self, $type_constraints) = @_;
+ $type_constraints = $self->type_constraints;
my @constraints = defined $type_constraints ? @$type_constraints : ();
Carp::confess( "too many args for Map type" ) if @constraints > 2;
@@ -191,33 +243,44 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
: @constraints == 1 ? (undef, @constraints)
: ();
- my %values = defined $values ? %$values: ();
- ## Perform the checking
- if ($value_type) {
- for my $value (values %$values) {
- unless ($value_type->check($value)) {
- if($_[2]) {
- my $message = $value_type->validate($value,$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ my ($key_check, $value_check, $is_compiled);
+ return sub {
+ my ($values, $err) = @_;
+ my %values = defined $values ? %$values: ();
+
+ unless ($is_compiled) {
+ ($key_check, $value_check)
+ = map { $_ ? $_->$CompiledTC : undef }
+ $key_type, $value_type;
+ $is_compiled++;
+ }
+
+ ## Perform the checking
+ if ($value_check) {
+ for my $value (values %$values) {
+ unless ($value_check->($value)) {
+ if($err) {
+ my $message = $value_type->validate($value,$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
+ }
}
- return;
}
- }
- }
-
- if ($key_type) {
- for my $key (keys %$values) {
- unless ($key_type->check($key)) {
- if($_[2]) {
- my $message = $key_type->validate($key,$_[2]);
- $_[2]->add_message({message=>$message,level=>$_[2]->level});
+ if ($key_check) {
+ for my $key (keys %$values) {
+ unless ($key_check->($key)) {
+ if($err) {
+ my $message = $key_type->validate($key,$err);
+ $err->add_message({message=>$message,level=>$err->level});
+ }
+ return;
+ }
}
- return;
}
- }
- }
- return 1;
+ return 1;
+ };
},
)
);
@@ -949,11 +1012,15 @@ Yuval Kogman <nothingmuch@woobling.org>
Tomas Doran <bobtfish@bobtfish.net>
+=item *
+
+Robert Sedlacek <rs@474.at>
+
=back
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2010 by John Napiorkowski.
+This software is copyright (c) 2011 by John Napiorkowski.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -15,17 +15,22 @@ my $list_tc = MooseX::Meta::TypeConstraint::Structured->new(
parent => $arrayref,
type_constraints => [$int, $str],
constraint_generator=> sub {
- my @type_constraints = @{shift @_};
- my @values = @{shift @_};
-
- while(my $type_constraint = shift @type_constraints) {
- my $value = shift @values || return;
- $type_constraint->check($value) || return;
- }
- if(@values) {
- return;
- } else {
- return 1;
+ my ($self) = @_;
+ my @type_constraints = @{ $self->type_constraints };
+
+ return sub {
+ my ($values, $err) = @_;
+ my @values = @$values;
+
+ for my $type_constraint (@type_constraints) {
+ my $value = shift @values || return;
+ $type_constraint->check($value) || return;
+ }
+ if(@values) {
+ return;
+ } else {
+ return 1;
+ }
}
}
);
@@ -2,7 +2,7 @@ BEGIN {
use strict;
use warnings;
use Test::More tests=>32;
- use Test::Exception;
+ use Test::Fatal;
}
{
@@ -50,9 +50,9 @@ isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Tuple'
## Test Tuple type constraint
-lives_ok sub {
+is( exception {
$record->tuple([1,'hello', 'test.abc.test']);
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
is $record->tuple->[0], 1
=> 'correct set the tuple attribute index 0';
@@ -63,81 +63,81 @@ is $record->tuple->[1], 'hello'
is $record->tuple->[2], 'test.abc.test'
=> 'correct set the tuple attribute index 2';
-throws_ok sub {
+like( exception {
$record->tuple([1,'hello', 'test.xxx.test']);
}, qr/Attribute \(tuple\) does not pass the type constraint/
- => 'Properly failed for bad value in custom type constraint';
+ => 'Properly failed for bad value in custom type constraint');
-throws_ok sub {
+like( exception {
$record->tuple(['asdasd',2, 'test.abc.test']);
}, qr/Attribute \(tuple\) does not pass the type constraint/
- => 'Got Expected Error for violating constraints';
+ => 'Got Expected Error for violating constraints');
## Test tuple_with_maybe
-lives_ok sub {
+is( exception {
$record->tuple_with_maybe([1,'hello', 1, $record]);
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->tuple_with_maybe([1,'hello', 'a', $record]);
}, qr/Attribute \(tuple_with_maybe\) does not pass the type constraint/
- => 'Properly failed for bad value parameterized constraint';
+ => 'Properly failed for bad value parameterized constraint');
-lives_ok sub {
+is( exception {
$record->tuple_with_maybe([1,'hello',undef, $record]);
-} => 'Set tuple attribute without error skipping optional parameter';
+} => undef, 'Set tuple attribute without error skipping optional parameter');
## Test tuple_with_maybe2
-lives_ok sub {
+is( exception {
$record->tuple_with_maybe2([1,'hello', 1]);
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->tuple_with_maybe2([1,'hello', 'a']);
}, qr/Attribute \(tuple_with_maybe2\) does not pass the type constraint/
- => 'Properly failed for bad value parameterized constraint';
+ => 'Properly failed for bad value parameterized constraint');
-lives_ok sub {
+is( exception {
$record->tuple_with_maybe2([1,'hello',undef]);
-} => 'Set tuple attribute without error skipping optional parameter';
+} => undef, 'Set tuple attribute without error skipping optional parameter');
SKIP: {
skip 'Core Maybe incorrectly allows null.', 1, 1;
- throws_ok sub {
+ like( exception {
$record->tuple_with_maybe2([1,'hello']);
}, qr/Attribute \(tuple_with_maybe2\) does not pass the type constraint/
- => 'Properly fails for missing maybe (needs to be at least undef)';
+ => 'Properly fails for missing maybe (needs to be at least undef)');
}
## Test Tuple with parameterized type
-lives_ok sub {
+is( exception {
$record->tuple_with_param([1,'hello', [1,2,3]]);
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->tuple_with_param([1,'hello', [qw/a b c/]]);
}, qr/Attribute \(tuple_with_param\) does not pass the type constraint/
- => 'Properly failed for bad value parameterized constraint';
+ => 'Properly failed for bad value parameterized constraint');
## Test tuple2 (Tuple[Int,Str,Int])
ok $record->tuple2([1,'hello',3])
=> "[1,'hello',3] properly suceeds";
-throws_ok sub {
+like( exception {
$record->tuple2([1,2,'world']);
-}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "[1,2,'world'] properly fails";
+}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "[1,2,'world'] properly fails");
-throws_ok sub {
+like( exception {
$record->tuple2(['hello1',2,3]);
-}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,3] properly fails";
+}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,3] properly fails");
-throws_ok sub {
+like( exception {
$record->tuple2(['hello2',2,'world']);
-}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,'world'] properly fails";
+}, qr/Attribute \(tuple2\) does not pass the type constraint/ => "['hello',2,'world'] properly fails");
## Test tuple_with_parameterized (Tuple[Int,Str,Int,ArrayRef[Int]])
@@ -145,54 +145,54 @@ throws_ok sub {
ok $record->tuple_with_parameterized([1,'hello',3,[1,2,3]])
=> "[1,'hello',3,[1,2,3]] properly suceeds";
-throws_ok sub {
+like( exception {
$record->tuple_with_parameterized([1,2,'world']);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
- => "[1,2,'world'] properly fails";
+ => "[1,2,'world'] properly fails");
-throws_ok sub {
+like( exception {
$record->tuple_with_parameterized(['hello1',2,3]);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
- => "['hello',2,3] properly fails";
+ => "['hello',2,3] properly fails");
-throws_ok sub {
+like( exception {
$record->tuple_with_parameterized(['hello2',2,'world']);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
- => "['hello',2,'world'] properly fails";
+ => "['hello',2,'world'] properly fails");
-throws_ok sub {
+like( exception {
$record->tuple_with_parameterized([1,'hello',3,[1,2,'world']]);
}, qr/Attribute \(tuple_with_parameterized\) does not pass the type constraint/
- => "[1,'hello',3,[1,2,'world']] properly fails";
+ => "[1,'hello',3,[1,2,'world']] properly fails");
## Test FiveByFiveAttr
-lives_ok sub {
+is( exception {
$record->FiveByFiveAttr([6,[7,8,9]]);
-} => 'Set FiveByFiveAttr correctly';
+} => undef, 'Set FiveByFiveAttr correctly');
-throws_ok sub {
+like( exception {
$record->FiveByFiveAttr([1,'hello', 'test']);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
- => q{Properly failed for bad value in FiveByFiveAttr [1,'hello', 'test']};
+ => q{Properly failed for bad value in FiveByFiveAttr [1,'hello', 'test']});
-throws_ok sub {
+like( exception {
$record->FiveByFiveAttr([1,[8,9,10]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
- => q{Properly failed for bad value in FiveByFiveAttr [1,[8,9,10]]};
+ => q{Properly failed for bad value in FiveByFiveAttr [1,[8,9,10]]});
-throws_ok sub {
+like( exception {
$record->FiveByFiveAttr([10,[11,12,0]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
- => q{Properly failed for bad value in FiveByFiveAttr [10,[11,12,0]]};
+ => q{Properly failed for bad value in FiveByFiveAttr [10,[11,12,0]]});
-throws_ok sub {
+like( exception {
$record->FiveByFiveAttr([1,[1,1,0]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
- => q{Properly failed for bad value in FiveByFiveAttr [1,[1,1,0]]};
+ => q{Properly failed for bad value in FiveByFiveAttr [1,[1,1,0]]});
-throws_ok sub {
+like( exception {
$record->FiveByFiveAttr([10,[11,12]]);
}, qr/Attribute \(FiveByFiveAttr\) does not pass the type constraint/
- => q{Properly failed for bad value in FiveByFiveAttr [10,[11,12]};
+ => q{Properly failed for bad value in FiveByFiveAttr [10,[11,12]});
@@ -2,7 +2,7 @@ BEGIN {
use strict;
use warnings;
use Test::More tests=>17;
- use Test::Exception;
+ use Test::Fatal;
}
{
@@ -32,9 +32,9 @@ isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Dict'
# Test dict Dict[name=>Str, age=>Int]
-lives_ok sub {
+is( exception {
$record->dict({name=>'frith', age=>23});
-} => 'Set dict attribute without error';
+} => undef, 'Set dict attribute without error');
is $record->dict->{name}, 'frith'
=> 'correct set the dict attribute name';
@@ -42,16 +42,16 @@ is $record->dict->{name}, 'frith'
is $record->dict->{age}, 23
=> 'correct set the dict attribute age';
-throws_ok sub {
+like( exception {
$record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
}, qr/Attribute \(dict\) does not pass the type constraint/
- => 'Got Expected Error for bad value in dict';
+ => 'Got Expected Error for bad value in dict');
## Test dict_with_maybe
-lives_ok sub {
+is( exception {
$record->dict_with_maybe({name=>'frith', age=>23});
-} => 'Set dict attribute without error';
+} => undef, 'Set dict attribute without error');
is $record->dict_with_maybe->{name}, 'frith'
=> 'correct set the dict attribute name';
@@ -59,40 +59,40 @@ is $record->dict_with_maybe->{name}, 'frith'
is $record->dict_with_maybe->{age}, 23
=> 'correct set the dict attribute age';
-throws_ok sub {
+like( exception {
$record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
}, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
- => 'Got Expected Error for bad value in dict';
+ => 'Got Expected Error for bad value in dict');
-throws_ok sub {
+like( exception {
$record->dict_with_maybe({age=>30});
}, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
- => 'Got Expected Error for missing named parameter';
+ => 'Got Expected Error for missing named parameter');
-lives_ok sub {
+is( exception {
$record->dict_with_maybe({name=>'usal', age=>undef});
-} => 'Set dict attribute without error, skipping maybe';
+} => undef, 'Set dict attribute without error, skipping maybe');
## Test dict_with_tuple_with_union: Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']]
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,'World']});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
- => 'Threw error on bad constraint';
+ => 'Threw error on bad constraint');
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>$record, key2=>[1,'World']});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,$record]});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->dict_with_tuple_with_union({key1=>1, key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
- => 'Threw error on bad constraint';
+ => 'Threw error on bad constraint');
@@ -2,7 +2,7 @@ BEGIN {
use strict;
use warnings;
use Test::More tests=>9;
- use Test::Exception;
+ use Test::Fatal;
}
{
@@ -26,35 +26,35 @@ isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Combined'
## Test dict_with_tuple
-lives_ok sub {
+is( exception {
$record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple\) does not pass the type constraint/
- => 'Threw error on bad constraint';
+ => 'Threw error on bad constraint');
## Test dict_with_tuple_with_union: Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']]
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,'World']});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
- => 'Threw error on bad constraint';
+ => 'Threw error on bad constraint');
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>$record, key2=>[1,'World']});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-lives_ok sub {
+is( exception {
$record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,$record]});
-} => 'Set tuple attribute without error';
+} => undef, 'Set tuple attribute without error');
-throws_ok sub {
+like( exception {
$record->dict_with_tuple_with_union({key1=>1, key2=>['World',2]});
}, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
- => 'Threw error on bad constraint';
+ => 'Threw error on bad constraint');
@@ -1,6 +1,7 @@
use strict;
use warnings;
use Test::More;
+use Test::Fatal;
use MooseX::Types::Moose qw(Int Num);
use MooseX::Types::Structured qw(Map);
@@ -9,11 +10,11 @@ my $type = Map[ Int, Num ];
ok($type->assert_valid({ 10 => 10.5 }), "simple Int -> Num mapping");
-eval { $type->assert_valid({ 10.5 => 10.5 }) };
-like($@, qr{value 10\.5}, "non-Int causes rejection on key");
+like( exception { $type->assert_valid({ 10.5 => 10.5 }) },
+ qr{value 10\.5}, "non-Int causes rejection on key");
-eval { $type->assert_valid({ 10 => "ten and a half" }) };
-like("$@", qr{value ten and a half}, "non-Num value causes rejection on value");
+like( exception { $type->assert_valid({ 10 => "ten and a half" }) },
+ qr{value ten and a half}, "non-Num value causes rejection on value");
ok($type->assert_valid({ }), "empty hashref is a valid mapping of any sort");
@@ -2,7 +2,7 @@ BEGIN {
use strict;
use warnings;
use Test::More tests=>16;
- use Test::Exception;
+ use Test::Fatal;
}
{
@@ -46,7 +46,7 @@ BEGIN {
has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength);
has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease);
has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo);
- has 'MorePersonalInfo' => (is=>'rw', isa=>MorePersonalInfo);
+ has 'MorePersonalInfoAttr' => (is=>'rw', isa=>MorePersonalInfo);
}
## Instantiate a new test object
@@ -59,75 +59,75 @@ isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Advanced'
## Test EqualLengthAttr
-lives_ok sub {
+is( exception {
$obj->EqualLengthAttr([[6,7,8],[9,10,11]]);
-} => 'Set EqualLengthAttr attribute without error';
+} => undef, 'Set EqualLengthAttr attribute without error');
-throws_ok sub {
+like( exception {
$obj->EqualLengthAttr([1,'hello', 'test.xxx.test']);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
- => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']};
+ => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']});
-throws_ok sub {
+like( exception {
$obj->EqualLengthAttr([[6,7],[9,10,11]]);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
- => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]};
+ => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]});
-throws_ok sub {
+like( exception {
$obj->EqualLengthAttr([[6,7,1],[9,10,11]]);
}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
- => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]};
+ => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]});
## Test MoreLengthPleaseAttr
-lives_ok sub {
+is( exception {
$obj->MoreLengthPleaseAttr([[6,7,8,9,10],[11,12,13,14,15]]);
-} => 'Set MoreLengthPleaseAttr attribute without error';
+} => undef, 'Set MoreLengthPleaseAttr attribute without error');
-throws_ok sub {
+like( exception {
$obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]);
}, qr/Attribute \(MoreLengthPleaseAttr\) does not pass the type constraint/
- => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]};
+ => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]});
## Test PersonalInfoAttr
-lives_ok sub {
+is( exception {
$obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-} => 'Set PersonalInfoAttr attribute without error 1';
+} => undef, 'Set PersonalInfoAttr attribute without error 1');
-lives_ok sub {
+is( exception {
$obj->PersonalInfoAttr({name=>'John', stats=>$obj});
-} => 'Set PersonalInfoAttr attribute without error 2';
+} => undef, 'Set PersonalInfoAttr attribute without error 2');
-throws_ok sub {
+like( exception {
$obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]});
}, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
- => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]};
+ => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]});
-throws_ok sub {
+like( exception {
$obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
}, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
- => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
+ => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-## Test MorePersonalInfo
+## Test MorePersonalInfoAttr
-lives_ok sub {
- $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-} => 'Set MorePersonalInfo attribute without error 1';
+is( exception {
+ $obj->MorePersonalInfoAttr({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+} => undef, 'Set MorePersonalInfoAttr attribute without error 1');
-throws_ok sub {
- $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
-}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
- => q{MorePersonalInfo correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]};
+like( exception {
+ $obj->MorePersonalInfoAttr({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
+}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/
+ => q{MorePersonalInfoAttr correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
-throws_ok sub {
- $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
- => q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
+like( exception {
+ $obj->MorePersonalInfoAttr({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/
+ => q{MorePersonalInfoAttr correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-throws_ok sub {
- $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
-}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
- => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
+like( exception {
+ $obj->MorePersonalInfoAttr({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
+}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/
+ => q{MorePersonalInfoAttr correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
@@ -2,7 +2,6 @@ BEGIN {
use strict;
use warnings;
use Test::More tests=>16;
- use Test::Exception;
}
{
@@ -2,7 +2,7 @@ use strict;
use warnings;
use Test::More tests=>46;
-use Test::Exception;
+use Test::Fatal;
use Moose::Util::TypeConstraints;
use MooseX::Types::Structured qw(Optional);
@@ -103,88 +103,88 @@ isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
# Test Insane
-lives_ok sub {
+is( exception {
$obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]);
-} => 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]';
+} => undef, 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]');
-lives_ok sub {
+is( exception {
$obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[1,2,3]]);
-} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]';
+} => undef, 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]');
-lives_ok sub {
+is( exception {
$obj->InsaneAttr([1,$obj,{name=>"John",age=>39}]);
-} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]';
+} => undef, 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]');
-throws_ok sub {
+like( exception {
$obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
- => q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]};
+ => q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]});
-throws_ok sub {
+like( exception {
$obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
- => q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]};
+ => q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]});
# Test TupleOptional1Attr
-lives_ok sub {
+is( exception {
$obj->TupleOptional1Attr([1,10,"hello"]);
-} => 'Set TupleOptional1Attr attribute without error [1,10,"hello"]';
+} => undef, 'Set TupleOptional1Attr attribute without error [1,10,"hello"]');
-lives_ok sub {
+is( exception {
$obj->TupleOptional1Attr([1,10,$obj]);
-} => 'Set TupleOptional1Attr attribute without error [1,10,$obj]';
+} => undef, 'Set TupleOptional1Attr attribute without error [1,10,$obj]');
-lives_ok sub {
+is( exception {
$obj->TupleOptional1Attr([1,10]);
-} => 'Set TupleOptional1Attr attribute without error [1,10]';
+} => undef, 'Set TupleOptional1Attr attribute without error [1,10]');
-throws_ok sub {
+like( exception {
$obj->TupleOptional1Attr([1,10,[1,2,3]]);
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
- => q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]};
+ => q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]});
-throws_ok sub {
+like( exception {
$obj->TupleOptional1Attr([1,10,undef]);
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
- => q{TupleOptional1Attr correctly fails [1,10,undef]};
+ => q{TupleOptional1Attr correctly fails [1,10,undef]});
# Test TupleOptional2Attr
-lives_ok sub {
+is( exception {
$obj->TupleOptional2Attr([1,10,{key1=>1,key2=>$obj}]);
-} => 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]';
+} => undef, 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]');
-lives_ok sub {
+is( exception {
$obj->TupleOptional2Attr([1,10]);
-} => 'Set TupleOptional2Attr attribute without error [1,10]';
+} => undef, 'Set TupleOptional2Attr attribute without error [1,10]');
-throws_ok sub {
+like( exception {
$obj->TupleOptional2Attr([1,10,[1,2,3]]);
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
- => q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]};
+ => q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]});
-throws_ok sub {
+like( exception {
$obj->TupleOptional2Attr([1,10,undef]);
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
- => q{TupleOptional2Attr correctly fails [1,10,undef]};
+ => q{TupleOptional2Attr correctly fails [1,10,undef]});
# Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
-lives_ok sub {
+is( exception {
$obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
-} => 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}';
+} => undef, 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}');
-lives_ok sub {
+is( exception {
$obj->DictOptional1Attr({name=>"Vanessa",age=>34});
-} => 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}';
+} => undef, 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}');
-throws_ok sub {
+like( exception {
$obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
- => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}};
+ => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}});
-throws_ok sub {
+like( exception {
$obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
- => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}};
+ => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}});
@@ -0,0 +1,84 @@
+use strict;
+use warnings;
+use Test::More;
+
+## Bug report was that if calling ->is_subtype on crap (not a type, etc) you
+## get a not very helpful error message. Fix was to make crap just return
+## boolean false to make this like the rest of Moose type constraints. I am
+## not convinced this is good, but at least is consistent.
+#
+# I also changed ->equals and ->is_a_type_of to be consistent
+
+{
+ package moosex::types::structured::bug_is_subtype;
+
+ use Moose;
+ use MooseX::Types -declare => [qw/ ThingType /];
+ use MooseX::Types::Moose qw/ Int Str /;
+ use MooseX::Types::Structured qw/ Dict /;
+
+ subtype ThingType, as Dict [ id => Int, name => Str, ];
+ has thing => ( is => 'ro', isa => ThingType, );
+}
+
+ok my $test = moosex::types::structured::bug_is_subtype->new,
+ 'created class';
+
+is(
+ moosex::types::structured::bug_is_subtype::ThingType,
+ 'moosex::types::structured::bug_is_subtype::ThingType',
+ 'correct type',
+);
+
+use MooseX::Types::Moose 'HashRef';
+
+is(
+ HashRef,
+ 'HashRef',
+ 'correct type',
+);
+
+ok(
+ moosex::types::structured::bug_is_subtype::ThingType->is_subtype_of(HashRef),
+ 'is a subtype',
+);
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->is_subtype_of(moosex::types::structured::bug_is_subtype::ThingType),
+ 'is not a subtype',
+);
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->is_subtype_of('SomeCrap'),
+ 'is not a subtype',
+);
+
+sub SomeCrap {}
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->is_subtype_of(SomeCrap),
+ 'is not a subtype',
+);
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->is_subtype_of(undef),
+ 'is not a subtype',
+);
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->equals(undef),
+ 'is not a subtype',
+);
+
+ok(
+ !moosex::types::structured::bug_is_subtype::ThingType
+ ->is_a_type_of(undef),
+ 'is not a subtype',
+);
+
+done_testing;